home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1997 April / EnigmA AMIGA RUN 17 (1997)(G.R. Edizioni)(IT)[!][issue 1997-04][EAR-CD].iso / EARCD / comm / thor / GetNET22.lha / GetNET / Rexx / GetNET.thor < prev   
Text File  |  1996-11-21  |  40KB  |  1,396 lines

  1. /*
  2.   $VER: GetNET.Thor 2.2 (21.11.96)
  3.   by Remco van Hooff
  4.  
  5.   See GetNET.guide for installation and usage.
  6.  
  7.   No need to edit anything in this script.
  8. */
  9.  
  10. /*!~ "Variables" */
  11. /*!~ "Filters" */
  12. /* don't edit these */
  13. cr = '0d'x
  14. lf = '0a'x
  15. tab= '09'x
  16.  
  17. /*!~ "trailing filter" */
  18. /* do not use '/' here! */
  19. filter.1.1 = cr
  20. filter.1.2 = lf
  21. filter.1.3 = ')'
  22. filter.1.4 = ','
  23. filter.1.5 = "'"
  24. filter.1.6 = '"'
  25. filter.1.7 = ']'
  26. filter.1.8 = '>'
  27. filter.1.9 = '}'
  28. filter.1.10 = '*'
  29. filter.1.11 = ';' 
  30. filter.1.12 = '`'
  31. filter.1.count = 11 /* number of filters */
  32. /*~!*/
  33.  
  34. /*!~ "preceeding filter" */
  35. filter.2.1 = '('
  36. filter.2.2 = '"'
  37. filter.2.3 = '<'
  38. filter.2.4 = '['
  39. filter.2.5 = '{'
  40. filter.2.6 = ':'
  41. filter.2.7 = "'"
  42. filter.2.8 = tab
  43. filter.2.9 = '/'
  44. filter.2.10 = '|'
  45. filter.2.11 = '`'
  46. filter.2.count = 11
  47. /*~!*/
  48.  
  49. /*!~ "filetypes" */
  50. /* for recognition of files in ftp URLs */
  51. /* UPPERCASE */
  52. filetype.1  = '.LZH'
  53. filetype.2  = '.LHA'
  54. filetype.3  = '.LZX'
  55. filetype.4  = '.ZIP'
  56. filetype.5  = '.GZIP'
  57. filetype.6  = '.Z'
  58. filetype.7  = '.GZ'
  59. filetype.8  = '.TAR'
  60. filetype.9  = '.TXT'
  61. filetype.10 = '.FAQ'
  62. filetype.11 = '.README'
  63. filetype.count = 11
  64. /*~!*/
  65. /*~!*/
  66.  
  67. /*!~ "Constants" */
  68. cfgpath = 'env:thor/'
  69. cfgfile = 'getnet.config'
  70.  
  71. version = SUBWORD(SOURCELINE(2), 3,1)
  72. maintitle = 'GetNET' version '© by Remco van Hooff'
  73. tempfile = 't:temp.tmp'
  74.  
  75. EVE_DOWNLOAD     =  4
  76.  
  77. extra    = 1 
  78.  
  79. reqfile   = 0
  80. scanhttp  = 0
  81. scanftp   = 0
  82. scanemail = 0
  83.  
  84. domains = '.EDU.ORG.COM.NET.GOV.MIL.AA.AD.AE.AF.AG.AL.AM.AO.AR.AT.AU.AZ.BA.BB.',
  85.           '.BD.BE.BF.BG.BH.BI.BJ.BM.BN.BO.BR.BS.BT.BW.BY.BZ.CA.CF.CG.CH.CI.CL.',
  86.           '.CM.CN.CO.CR.CU.CV.CY.CZ.DE.DJ.DK.DM.DO.DZ.EC.EE.EG.EP.ES.ET.FI.FJ.',
  87.           '.FR.GA.GB.GD.GE.GH.GM.GN.GQ.GR.GT.GU.GW.GY.HK.HN.HR.HT.HU.ID.IE.IL.',
  88.           '.IN.IQ.IR.IS.IT.JM.JO.JP.KE.KG.KH.KI.KM.KP.KR.KW.KZ.LA.LB.LC.LI.LK.',
  89.           '.LR.LS.LT.LU.LV.LY.MA.MC.MD.MG.ML.MM.MN.MR.MT.MU.MV.MW.MX.MY.MZ.NA.',
  90.           '.NE.NG.NI.NL.NO.NP.NR.NZ.OM.PA.PE.PG.PH.PK.PL.PR.PT.PY.QA.QS.QZ.RO.',
  91.           '.RU.RW.SA.SB.SC.SD.SE.SG.SI.SK.SL.SM.SN.SO.SR.ST.SV.SY.SZ.TD.TG.TH.',
  92.           '.TJ.TM.TN.TO.TR.TT.TV.TW.TZ.UA.UG.UK.US.UY.UZ.VA.VC.VE.VN.VU.WO.WS.',
  93.           '.XA.XC.XD.XE.XF.XH.XI.XJ.XK.XN.XO.XR.XS.XT.XU.XW.XX.XY.XZ.YE.YU.ZA.',
  94.           '.ZM.ZR.ZW.ZZ.INT.'
  95.  
  96. /*---------------------------------------------------------------------------*/
  97.  
  98. /*~!*/
  99. /*~!*/
  100.  
  101. /*!~ "Init" */
  102. OPTIONS RESULTS
  103. OPTIONS FAILAT 31
  104. SIGNAL ON HALT
  105. SIGNAL ON SYNTAX
  106. /*TRACE RESULTS*/
  107.  
  108. p=' '||ADDRESS()||' '||SHOW('P',,)
  109. IF POS(' THOR.',p)>0 THEN thorport=WORD(SUBSTR(p,POS(' THOR.',p)+1),1)
  110. ELSE DO
  111.   SAY 'THOR port not found!'
  112.   EXIT 10
  113. END
  114.  
  115. IF ~SHOW('p', 'BBSREAD') THEN DO
  116.   ADDRESS COMMAND
  117.     "run >nil: `GetEnv THOR/THORPath`bin/LoadBBSRead"
  118.     "WaitForPort BBSREAD"
  119. END
  120.  
  121. IF ~SHOW('L','rexxsupport.library') THEN CALL ADDLIB('rexxsupport.library',0,-30,0)
  122. IF ~SHOW('L','rexxsupport.library') THEN DO
  123.   'REQUESTNOTIFY TEXT "Couldn''t open rexxsupport.library" BT "_Ok"'
  124.   EXIT
  125. END
  126. /*~!*/
  127.  
  128. /*!~ "Main loop" */
  129. ADDRESS(thorport)
  130. PARSE ARG req
  131.  
  132. CALL loadprefs
  133. ftpsavemode = Upper(ftpsavemode)
  134.  
  135. pro_http = amosaic+aweb+ibrowse+voyager+html+tcpdl
  136. pro_ftp  = ncftp+dopus+guiftp+amftp
  137.  
  138. IF askfr = 1 THEN CALL askreq
  139. IF upper(req) = 'REQ' THEN CALL request_file
  140. IF reqfile = 0 THEN CALL getmsg_selected
  141. CALL cleanup
  142. EXIT
  143. /*~!*/
  144.  
  145. /*!~ "Msg handling" */
  146. /*!~ "getmsg_selected" */
  147. getmsg_selected:
  148.   'GETMSGLISTSELECTED STEM' sel
  149.   SELECT
  150.     WHEN (RC = 30) THEN DO
  151.       'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  152.       CALL cleanup
  153.     END
  154.     WHEN ((RC = 3) | (RC = 5)) THEN DO
  155.       CALL current_msg
  156.       CALL msg_info
  157.       CALL main
  158.     END
  159.     OTHERWISE DO
  160.       'CURRENTSYSTEM SYS'
  161.       IF RC = 30 THEN DO
  162.         'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  163.         CALL cleanup
  164.       END
  165.       IF RC = 1 THEN DO
  166.         'REQUESTNOTIFY TEXT "No open system!" BT "_Ok"'
  167.         CALL cleanup
  168.       END
  169.       curbbs  = SYS.BBSNAME
  170.       curconf = SYS.CONFNAME
  171.       'OPENPROGRESS TITLE "'maintitle'" TOTAL' sel.count 'AT "_Abort" PT "Scanning messages (0/'sel.count')"'
  172.       IF(RC ~= 0) THEN DO
  173.         'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  174.         CALL cleanup
  175.       END
  176.       ELSE progressid1 = RESULT
  177.  
  178.       DO multi = 1 TO sel.COUNT
  179.         'UPDATEPROGRESS REQ' progressid1 'CURRENT' multi 'PT "Scanning messages ('multi'/'sel.count')"'
  180.         IF RC = 5 THEN CALL cleanup 
  181.         IF(RC = 30) THEN DO
  182.           'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  183.           CALL cleanup
  184.         END
  185.         msgnum = sel.multi
  186.         CALL msg_info 
  187.         CALL main 
  188.       END
  189.       'CLOSEPROGRESS REQ' progressid1
  190.     END
  191.   END
  192. RETURN
  193. /*~!*/
  194.  
  195. /*!~ "current_msg" */
  196. current_msg:
  197.   'CURRENTMSG stem' MSG
  198.   IF(RC ~= 0) THEN DO
  199.     'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  200.     CALL cleanup
  201.   END
  202.   msgnum  = MSG.MSGNR
  203.   curbbs  = MSG.BBSNAME
  204.   curconf = MSG.CONFNAME
  205. RETURN
  206. /*~!*/
  207.  
  208. /*!~ "msg_info" */
  209. msg_info:
  210.   ADDRESS bbsread 'READBRMESSAGE BBSNAME "'curbbs'" CONFNAME "'curconf'" MSGNR' msgnum 'HEADSTEM' headtags
  211.   IF(RC ~= 0) THEN DO
  212.     'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_Ok"'
  213.     CALL cleanup
  214.   END
  215.   fromname = HEADTAGS.FROMNAME
  216.   subj = HEADTAGS.SUBJECT
  217.   IF POS('RE:',UPPER(subj)) ~=0 THEN subj = SUBSTR(subj,5)
  218. RETURN
  219. /*~!*/
  220.  
  221. /*!~ "main" */
  222. main:
  223.   DROP FOUND. SAVE. NAME.
  224.   IF (scanhttp = 0 & scanftp = 0 & scanemail = 0) THEN DO
  225.     'REQUESTNOTIFY TEXT "Select a URL to scan for." BT "_HTTP|_Email|_FTP|_Aminet|_Quit"'
  226.     SELECT
  227.       WHEN RESULT = 1 THEN scanhttp = 1
  228.       WHEN RESULT = 2 THEN scanemail = 1
  229.       WHEN RESULT = 3 THEN scanftp = 1
  230.       WHEN RESULT = 4 THEN scanaminet = 1
  231.       OTHERWISE CALL cleanup
  232.     END
  233.   END  
  234.   SELECT
  235.     WHEN scanhttp = 1 THEN CALL get_http
  236.     WHEN scanemail = 1 THEN CALL get_email
  237.     WHEN scanftp = 1 THEN CALL get_ftp
  238.     WHEN scanaminet = 1 THEN CALL get_aminet
  239.     OTHERWISE NOP
  240.   END
  241. RETURN
  242. /*~!*/
  243. /*~!*/
  244.  
  245. /*!~ "GetHTTP" */
  246. /*!~ "get_http" */
  247. get_http:
  248.   'OPENPROGRESS TITLE "'maintitle'" TOTAL 0 AT "_Abort" PT "Hold on, saving message..."'
  249.   IF(RC ~= 0) THEN DO
  250.     'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  251.     CALL cleanup
  252.   END
  253.   ELSE progressid = RESULT
  254.   IF reqfile = 0 THEN DO
  255.     'SAVEMESSAGE BBSNAME "'curbbs'" CONFNAME "'curconf'" MSGNR' msgnum 'FILENAME' tempfile 'NOANSI OVERWRITE'
  256.     IF(RC ~= 0) THEN DO
  257.       'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  258.       CALL cleanup
  259.     END
  260.   END
  261.   CALL gethttp
  262.   CALL listfound
  263.   IF ok = 1 THEN CALL listsave(1)
  264. RETURN
  265. /*~!*/
  266.  
  267. /*!~ "gethttp" */
  268. gethttp:
  269.   opentmp = OPEN(tmp, tempfile, 'R')
  270.   filelngth = SEEK(tmp,0,'E')
  271.   'UPDATEPROGRESS REQ' progressid 'TOTAL' filelngth 'PT "Searching... (0)"'
  272.   IF RC = 5 THEN CALL cleanup 
  273.   IF(RC = 30) THEN DO
  274.     'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  275.     CALL cleanup
  276.   END
  277.   CALL SEEK(tmp, 0,'B')
  278.   num = 0; found.count = 0; sumadres = ''; curpos = 0
  279.   DO UNTIL curpos = filelngth
  280.     msg = READLN(tmp)
  281.     curpos = SEEK(tmp, 0)
  282.     IF curpos // 10 = 0 THEN 'UPDATEPROGRESS REQ' progressid 'CURRENT' curpos
  283.     IF RC = 5 THEN CALL cleanup
  284.     IF(RC = 30) THEN DO
  285.       'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  286.       CALL cleanup
  287.     END
  288.     httpadres = ''
  289.     DO FOREVER
  290.       IF ((POS('WWW', UPPER(msg)) ~= 0) & (POS('TTP://', UPPER(msg)) ~= POS('WWW', UPPER(msg)) - 6))  THEN DO
  291.         msg1 = OVERLAY('www', msg, POS('WWW',UPPER(msg)))
  292.         PARSE VAR msg1 . 'www' httpadres rest
  293.         IF httpadres ~= '' THEN httpadres = 'www'||httpadres
  294.       END
  295.       ELSE DO
  296.         IF POS('HTTP://', UPPER(msg)) ~= 0 THEN DO
  297.           msg1 = OVERLAY('http', msg, POS('HTTP://',UPPER(msg)))
  298.           PARSE VAR msg1 . 'http://' httpadres rest
  299.         END
  300.       END
  301.       IF httpadres ~= '' THEN DO
  302.         CALL filter(httpadres,1)
  303.         httpadres = 'http://'||RESULT
  304.         CALL checkdomain(httpadres, 'HTTP')
  305.         PARSE VAR httpadres 'http://' num1 '.' num2 '.' num3 '.' num4
  306.         IF (DATATYPE(num1, 'NUM') & DATATYPE(num2, 'NUM') & DATATYPE(num3, 'NUM') & num4 ~= '') THEN domainOK = 1
  307.         CALL dubbel(httpadres,0)
  308.       END
  309.       IF (POS('HTTP://', UPPER(rest)) ~= 0 | POS('WWW', UPPER(rest)) ~= 0) THEN DO
  310.         msg = rest
  311.         empty = 0
  312.       END 
  313.       ELSE empty = 1
  314.       IF empty = 1 THEN LEAVE
  315.     END
  316.   END
  317.   'CLOSEPROGRESS REQ' progressid
  318.   CALL CLOSE(tmp)
  319.   IF reqfile = 0 THEN DELETE(tempfile)
  320. RETURN
  321. /*~!*/
  322. /*~!*/
  323.  
  324. /*!~ "GetEmail" */
  325. /*!~ "get_email" */
  326. get_email:
  327.   'OPENPROGRESS TITLE "'maintitle'" TOTAL 0 AT "_Abort" PT "Hold on, saving message..."'
  328.   IF(RC ~= 0) THEN DO
  329.     'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  330.     CALL cleanup
  331.   END
  332.   ELSE progressid = RESULT
  333.   IF reqfile = 0 THEN DO
  334.     'SAVEMESSAGE BBSNAME "'curbbs'" CONFNAME "'curconf'" MSGNR' msgnum 'FILENAME' tempfile 'NOHEADER NOANSI OVERWRITE'
  335.     IF(RC ~= 0) THEN DO
  336.       'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  337.       CALL cleanup
  338.     END
  339.   END
  340.   CALL getemail
  341.   CALL listfound
  342.   IF ok = 1 THEN CALL listsave(2)
  343. RETURN
  344. /*~!*/
  345.  
  346. /*!~ "getemail" */
  347. getemail:
  348.   opentmp = OPEN(tmp, tempfile, 'r')
  349.   filelngth = SEEK(tmp,0,'E')
  350.   'UPDATEPROGRESS REQ' progressid 'TOTAL' filelngth 'PT "Searching... (0)"'
  351.   IF RC = 5 THEN CALL cleanup 
  352.   IF(RC = 30) THEN DO
  353.     'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  354.     CALL cleanup
  355.   END
  356.   CALL SEEK(tmp, 0,'B')
  357.   num = 0; found.count = 0; sumadres = ''; curpos = 0
  358.   DO UNTIL curpos = filelngth
  359.     msg = READLN(tmp)
  360.     curpos = SEEK(tmp, 0)
  361.     IF curpos // 10 = 0 THEN 'UPDATEPROGRESS REQ' progressid 'CURRENT' curpos
  362.     IF RC = 5 THEN CALL cleanup
  363.     IF(RC = 30) THEN DO
  364.       'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  365.       CALL cleanup
  366.     END
  367.     PARSE VAR msg part1 '@' part2 '.' part3 rest
  368.     DO FOREVER
  369.       IF (part2 ~= '' & POS(' ',part2) = 0 & part3 ~= '') THEN DO
  370.         spc = LASTPOS(' ', part1)
  371.         IF spc ~= 0 THEN part1 = DELSTR(part1, 1, spc)
  372.         CALL filter(part1,2)
  373.         part1 = RESULT
  374.         CALL filter(part3,1)
  375.         part3 =  RESULT
  376.         email = part1'@'part2'.'adres
  377.         CALL dubbel(email, 1)
  378.       END
  379.       IF POS('@', rest) ~= 0 THEN DO
  380.         PARSE VAR rest part1 '@' part2 '.' part3 rest
  381.         empty = 0
  382.       END 
  383.       ELSE empty = 1
  384.       IF empty = 1 THEN LEAVE
  385.     END
  386.   END
  387.   'CLOSEPROGRESS REQ' progressid
  388.   CALL CLOSE(tmp)
  389.   IF reqfile = 0 THEN DELETE(tempfile)
  390. RETURN
  391. /*~!*/
  392.  
  393. /*!~ "userdata" */
  394. userdata:
  395.   IF alias.n = 'ALIAS.'n THEN alias.n = ''
  396.   IF comm.n  = 'COMM.'n  THEN comm.n  = ''
  397.   showdata.1 = 'name    :' name.n
  398.   showdata.2 = 'address :' save.n
  399.   showdata.3 = 'alias   :' alias.n
  400.   showdata.4 = 'comment :' comm.n
  401.   showdata.5 = ''
  402.   showdata.6 = 'RETURN'
  403.   showdata.count = 6
  404.   titel = 'Userdata for' save.n
  405.   'REQUESTLIST INSTEM' showdata 'TITLE "'titel'" SIZEGADGET'
  406.   IF (RC = 30) THEN DO
  407.     'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  408.     CALL cleanup
  409.   END
  410.   IF RC ~= 5 THEN DO
  411.     sel = RESULT
  412.     IF sel = showdata.1 THEN DO
  413.       RESULT = name.n
  414.       'REQUESTSTRING TITLE "Enter a name for" BT "_OK|_From:|_Cancel" BODY "'save.n'" INITIALSTRING "'name.n'"'
  415.       IF THORRC = 0 then name.n = ''
  416.       IF THORRC = 1 then name.n = RESULT
  417.       IF THORRC = 2 THEN name.n = fromname
  418.     END
  419.     IF sel = showdata.2 THEN DO
  420.       RESULT = save.n
  421.       'REQUESTSTRING TITLE "Change address" BT "_OK|_Cancel" BODY "'save.n'" INITIALSTRING "'save.n'"'
  422.       save.n = RESULT
  423.     END
  424.     IF sel = showdata.3 THEN DO
  425.       RESULT = alias.n
  426.       'REQUESTSTRING TITLE "Enter an alias for" BT "_OK|_Cancel" BODY "'save.n'" INITIALSTRING "'alias.n'"'
  427.       alias.n = RESULT
  428.     END
  429.     IF sel = showdata.4 THEN DO
  430.       RESULT = comm.n
  431.       'REQUESTSTRING TITLE "Enter a comment for" BT "_OK|_Cancel" BODY "'save.n'" INITIALSTRING "'comm.n'"'
  432.       comm.n = RESULT
  433.     END
  434.     IF sel = 'RETURN' THEN SIGNAL listsave(2)
  435.     SIGNAL userdata
  436.   END
  437. RETURN
  438. /*~!*/
  439.  
  440. /*!~ "save_userdata" */
  441. save_userdata:
  442.   DROP USER.
  443.   DO i = 1 TO save.count
  444.     IF name.i = '' THEN DO
  445.       PARSE VAR save.i part1 '@'
  446.       name.i = part1
  447.     END
  448.     USER.NAME      = name.i
  449.     USER.ADDRESS   = save.i
  450.     USER.ALIAS     = alias.i
  451.     USER.COMMENT.1 = comm.i
  452.     IF USER.COMMENT.1 = '' THEN USER.COMMENT.COUNT = 0
  453.     ELSE USER.COMMENT.COUNT = 1
  454.     ADDRESS BBSREAD 'WRITEBRUSER BBSNAME "'bbs'" STEM USER ONLYIFEXIST'
  455.     IF RC~=0 THEN DO
  456.       'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_Ok"'
  457.       CALL cleanup
  458.     END
  459.   END
  460. RETURN
  461. /*~!*/
  462. /*~!*/
  463.  
  464. /*!~ "GetFTP" */
  465. /*!~ "get_ftp" */
  466. get_ftp:
  467.   'OPENPROGRESS TITLE "'maintitle'" TOTAL 0 AT "_Abort" PT "Hold on, saving message..."'
  468.   IF(RC ~= 0) THEN DO
  469.     'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  470.     CALL cleanup
  471.   END
  472.   ELSE progressid = RESULT
  473.   IF reqfile = 0 THEN DO
  474.     'SAVEMESSAGE BBSNAME "'curbbs'" CONFNAME "'curconf'" MSGNR' msgnum 'FILENAME' tempfile 'NOHEADER NOANSI OVERWRITE'
  475.     IF(RC ~= 0) THEN DO
  476.       'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  477.       CALL cleanup
  478.     END
  479.   END
  480.   CALL getftp
  481.   CALL listfound
  482.   IF ok = 1 THEN CALL listsave(1)
  483. RETURN
  484. /*~!*/
  485.  
  486. /*!~ "getftp" */
  487. getftp:
  488.   opentmp = OPEN(tmp, tempfile, 'R')
  489.   filelngth = SEEK(tmp,0,'E')
  490.   'UPDATEPROGRESS REQ' progressid 'TOTAL' filelngth 'PT "Searching... (0)"'
  491.   IF RC = 5 THEN CALL cleanup 
  492.   IF(RC = 30) THEN DO
  493.     'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  494.      CALL cleanup
  495.   END
  496.   CALL SEEK(tmp, 0,'B')
  497.   num = 0; found.count = 0; sumadres = ''; curpos = 0
  498.   DO UNTIL curpos = filelngth
  499.     msg = READLN(tmp)
  500.     curpos = SEEK(tmp, 0)
  501.     IF curpos // 10 = 0 THEN 'UPDATEPROGRESS REQ' progressid 'CURRENT' curpos
  502.     IF RC = 5 THEN CALL cleanup
  503.     IF(RC = 30) THEN DO
  504.       'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  505.       CALL cleanup
  506.     END
  507.     IF POS('FTP://', UPPER(msg)) ~=0 THEN DO
  508.       CALL getftp2
  509.     END
  510.     IF extra = 1 THEN DO
  511.       CALL getip
  512.     END
  513.   END
  514.   'CLOSEPROGRESS REQ' progressid
  515.   CALL CLOSE(tmp)
  516.   IF reqfile = 0 THEN DELETE(tempfile)
  517. RETURN
  518. /*~!*/
  519.  
  520. /*!~ "getftp2" */
  521. getftp2:
  522.   msg2 = OVERLAY('ftp', msg, POS('FTP://',UPPER(msg)))
  523.   PARSE VAR msg2 . 'ftp://' ftpadres rest
  524.   DO FOREVER    
  525.     IF ftpadres ~= '' THEN DO
  526.       CALL filter(ftpadres,1)
  527.       ftpadres = 'ftp://'||RESULT
  528.       CALL checkdomain(ftpadres, 'FTP')
  529.       CALL dubbel(ftpadres, 0)
  530.     END
  531.     IF POS('FTP://', UPPER(rest)) ~= 0 THEN DO
  532.       msg2 = OVERLAY('ftp', rest, POS('FTP://',UPPER(rest)))
  533.       PARSE VAR msg2 . 'ftp://' ftpadres rest
  534.       empty = 0
  535.     END 
  536.     ELSE empty = 1
  537.     IF empty = 1 THEN LEAVE
  538.   END
  539. RETURN
  540. /*~!*/
  541.  
  542. /*!~ "getip" */
  543. getip:
  544.   msg2 = SPACE(msg,1,'|')
  545.   PARSE VAR msg2 part1'.'part2'|'rest
  546.   DO FOREVER
  547.     domainOK = 0
  548.     IF (POS('HTTP://',UPPER(part1))~=0) THEN LEAVE
  549.     IF ((part2 ~= '' & POS('|',part2) = 0) & (length(part1)>1 & length(part2)>1)) THEN DO
  550.       CALL filter(part1,2)
  551.       part1 = RESULT
  552.       CALL filter(part2,1)
  553.       part2 =  RESULT
  554.       ftpadres = 'ftp://'part1'.'part2
  555.       IF (pos('@',ftpadres) = 0 & pos('www', ftpadres) = 0 & LENGTH(part2) >= 2 & pos('..', ftpadres) = 0) THEN DO
  556.         part2 = '.'part2
  557.         CALL checkdomain(ftpadres, 'IP')
  558.         IF DATATYPE(part1, 'NUM') THEN DO
  559.           PARSE VAR ftpadres 'ftp://' num1 '.' num2 '.' num3 '.' num4
  560.           IF (DATATYPE(num1, 'NUM') & DATATYPE(num2, 'NUM') & DATATYPE(num3, 'NUM') & num4 ~= '') THEN domainOK = 1
  561.         END
  562.       CALL dubbel(ftpadres, 0)
  563.       END
  564.     END
  565.     IF POS('.', rest) ~= 0 THEN DO
  566.       PARSE VAR rest part1'.'part2'|'rest
  567.       empty = 0
  568.     END
  569.     ELSE empty = 1
  570.     IF empty = 1 THEN LEAVE
  571.   END
  572. RETURN
  573. /*~!*/
  574. /*~!*/
  575.  
  576. /*!~ "GetAminet" */
  577. /*!~ "get_aminet" */
  578. get_aminet:
  579.   'OPENPROGRESS TITLE "'maintitle'" TOTAL 0 AT "_Abort" PT "Hold on, saving message..."'
  580.   IF(RC ~= 0) THEN DO
  581.     'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  582.     CALL cleanup
  583.   END
  584.   ELSE progressid = RESULT
  585.   IF reqfile = 0 THEN DO
  586.     'SAVEMESSAGE BBSNAME "'curbbs'" CONFNAME "'curconf'" MSGNR' msgnum 'FILENAME' tempfile 'NOANSI OVERWRITE NOHEADER'
  587.     IF(RC ~= 0) THEN DO
  588.       'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  589.       CALL cleanup
  590.     END
  591.   END
  592.   CALL getaminet
  593.   CALL listfound
  594.   IF ok = 1 THEN CALL create_dlevent
  595. RETURN
  596. /*~!*/
  597.  
  598. /*!~ "getaminet" */
  599. getaminet:
  600.   opentmp = OPEN(tmp, tempfile, 'R')
  601.   filelngth = SEEK(tmp,0,'E')
  602.   'UPDATEPROGRESS REQ' progressid 'TOTAL' filelngth 'PT "Searching... (0)"'
  603.   IF RC = 5 THEN CALL cleanup
  604.   IF(RC = 30) THEN DO
  605.     'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  606.      CALL cleanup
  607.   END
  608.   CALL SEEK(tmp, 0,'B')
  609.   num = 0; found.count = 0; sumadres = ''; curpos = 0
  610.   DO UNTIL curpos = filelngth
  611.     msg = READLN(tmp)
  612.     curpos = SEEK(tmp, 0)
  613.     IF curpos // 10 = 0 THEN 'UPDATEPROGRESS REQ' progressid 'CURRENT' curpos
  614.     IF RC = 5 THEN CALL cleanup
  615.     IF RC = 30 THEN DO
  616.       'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  617.       CALL cleanup
  618.     END
  619.     IF RC = 0 THEN DO
  620.       PARSE VAR msg 1 file 20 dir1'/'dir2 .
  621.       file = strip(file)
  622.       dir = strip(dir1'/'dir2)
  623.       IF (POS('AHL.', UPPER(REVERSE(file))) = 1 | POS('SMD.', UPPER(REVERSE(file))) = 1 | POS('HZL.', UPPER(REVERSE(file))) = 1) THEN DO
  624.         aminetfile = LEFT(file,20, ' ')||'('||dir||')'
  625.         CALL dubbel(aminetfile,1)
  626.         curpos = SEEK(tmp, 0)
  627.       END
  628.     END
  629.   END
  630.   'CLOSEPROGRESS REQ' progressid
  631.   CALL CLOSE(tmp)
  632.   IF reqfile = 0 THEN DELETE(tempfile)
  633. RETURN
  634. /*~!*/
  635. /*~!*/
  636.  
  637. /*!~ "Save hotlists" */
  638. /*!~ "savehotlist" */
  639. savehotlist:
  640.   IF scanhttp = 1 THEN savetotal = pro_http
  641.   IF (scanftp = 1 & ftpsavemode = 'W') THEN savetotal = pro_http
  642.   IF (scanftp = 1 & ftpsavemode = 'B') THEN savetotal = pro_http + pro_ftp
  643.   IF (scanftp = 1 & ftpsavemode = 'F') THEN savetotal = pro_ftp
  644.  
  645.   DO sv = 1 TO save.count
  646.     IF name.sv = '' THEN name.sv = subj '('sv')'
  647.   END
  648.   'OPENPROGRESS TITLE "'maintitle'" TOTAL' savetotal ' PT "Saving addresses..."'
  649.   IF(RC ~= 0) THEN DO
  650.     'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  651.     CALL cleanup
  652.   END
  653.   ELSE pbsave = RESULT
  654.  
  655.   IF amosaic = 1 THEN DO
  656.     IF (scanftp = 1 & (ftpsavemode = 'W' | ftpsavemode = 'B')) THEN CALL save_amosaic
  657.     IF scanftp = 0 THEN CALL save_amosaic
  658.   END
  659.   IF ibrowse = 1 THEN DO
  660.     IF (scanftp = 1 & (ftpsavemode = 'W' | ftpsavemode = 'B')) THEN CALL save_ibrowse
  661.     IF scanftp = 0 THEN CALL save_ibrowse
  662.   END
  663.   IF html    = 1 THEN DO
  664.     IF (scanftp = 1 & (ftpsavemode = 'W' | ftpsavemode = 'B')) THEN CALL save_html
  665.     IF scanftp = 0 THEN CALL save_html
  666.   END
  667.   IF aweb    = 1 THEN DO
  668.     IF (scanftp = 1 & (ftpsavemode = 'W' | ftpsavemode = 'B')) THEN CALL save_aweb
  669.     IF scanftp = 0 THEN CALL save_aweb
  670.   END
  671.   IF voyager = 1 THEN DO
  672.     IF (scanftp = 1 & (ftpsavemode = 'W' | ftpsavemode = 'B')) THEN CALL save_voyager
  673.     IF scanftp = 0 THEN CALL save_voyager
  674.   END
  675.   IF tcpdl = 1 THEN DO
  676.     IF (scanftp = 1 & (ftpsavemode = 'W' | ftpsavemode = 'B')) THEN CALL save_tcpdl
  677.     IF scanftp = 0 THEN CALL save_tcpdl
  678.   END
  679.   IF (ncftp   = 1 & scanftp = 1 & (ftpsavemode = 'F' | ftpsavemode = 'B')) THEN CALL save_ncftp
  680.   IF (dopus   = 1 & scanftp = 1 & (ftpsavemode = 'F' | ftpsavemode = 'B')) THEN CALL save_dopus
  681.   IF (guiftp  = 1 & scanftp = 1 & (ftpsavemode = 'F' | ftpsavemode = 'B')) THEN CALL save_guiftp
  682.   IF (amftp   = 1 & scanftp = 1 & (ftpsavemode = 'F' | ftpsavemode = 'B')) THEN CALL save_amftp
  683.   'CLOSEPROGRESS REQ' pbsave
  684.   IF pro_http + pro_ftp = 0 THEN 'REQUESTNOTIFY "No hotlist(s) configured.\nUse CfgGetNET to configure them." "_OK"'
  685. RETURN
  686. /*~!*/
  687.  
  688. /*!~ "save_amosaic" */
  689. save_amosaic:
  690.   IF ~EXISTS(hotlist_amosaic) THEN DO
  691.     'REQUESTNOTIFY "Amosaic hotlist not found!" "_OK"'
  692.     RETURN
  693.   END
  694.   ELSE DO
  695.     'UPDATEPROGRESS REQ' pbsave 'CURRENT' amosaic 'PT "Saving to AMosaic..."'
  696.     IF RC = 5 THEN CALL cleanup
  697.     IF(RC = 30) THEN DO
  698.       'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  699.       CALL cleanup
  700.     END
  701.     dat = DATE()
  702.     PARSE VAR dat dagnr maand jaar
  703.     dag = LEFT(DATE('W', DATE(S), 'S'), 3)
  704.     datum = dag maand dagnr TIME()jaar
  705.     CALL OPEN(htlst,hotlist_amosaic,'a')
  706.     DO sa = 1 TO save.count
  707.       CALL WRITELN(htlst,save.sa||' '||datum)
  708.       CALL WRITELN(htlst,STRIP(name.sa))
  709.     END
  710.     CALL CLOSE(htlst)
  711.   END
  712.   ADDRESS COMMAND 'copy' hotlist_amosaic 'env:mosaic/ quiet'
  713. RETURN
  714. /*~!*/
  715.  
  716. /*!~ "save_ibrowse" */
  717. save_ibrowse:
  718.   IF ~EXISTS(hotlist_ibrowse) THEN DO
  719.     'REQUESTNOTIFY "IBrowse hotlist not found!" "_OK"'
  720.     RETURN
  721.   END
  722.   ELSE DO
  723.     'UPDATEPROGRESS REQ' pbsave 'CURRENT' amosaic+ibrowse 'PT "Saving to IBrowse..."'
  724.     IF RC = 5 THEN CALL cleanup
  725.     IF(RC = 30) THEN DO
  726.       'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  727.       CALL cleanup
  728.     END
  729.     CALL OPEN(in,hotlist_ibrowse,'r')
  730.     CALL OPEN(out,'t:IBrowse.tmp','w')
  731.       line = READLN(in)
  732.       DO UNTIL line = '<UL>'
  733.         WRITELN(out, line)
  734.         line = READLN(in)
  735.       END
  736.       WRITELN(out, line)
  737.       DO si = 1 TO save.count
  738.         adres = '<LI><A HREF="'||save.si||'">'STRIP(name.si)'</A><br>'
  739.         WRITELN(out, adres)
  740.       END
  741.       DO UNTIL EOF(in)
  742.         rest = readch(in,1048576)
  743.         WRITECH(out, rest)
  744.       END
  745.     CALL CLOSE(out)
  746.     CALL CLOSE(in)
  747.     ADDRESS COMMAND 'copy t:ibrowse.tmp' hotlist_ibrowse 'quiet'
  748.     DELETE('t:ibrowse.tmp')
  749.   END
  750. RETURN
  751. /*~!*/
  752.  
  753. /*!~ "save_html" */
  754. save_html:
  755.   IF ~EXISTS(hotlist_html) THEN DO
  756.     'REQUESTNOTIFY "HTML hotlist not found!" "_OK"'
  757.     RETURN
  758.   END
  759.   ELSE DO
  760.     'UPDATEPROGRESS REQ' pbsave 'CURRENT' amosaic+ibrowse+html 'PT "Saving to HTML..."'
  761.     IF RC = 5 THEN CALL cleanup
  762.     IF(RC = 30) THEN DO
  763.       'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  764.       CALL cleanup
  765.     END
  766.     CALL OPEN(htlst,hotlist_html,'a')
  767.     DO sh = 1 TO save.count
  768.       CALL WRITELN(htlst,'<LI><A HREF="'save.sh'">'STRIP(name.sh)'</A><br>')
  769.     END
  770.     CALL CLOSE(htlst)
  771.   END
  772. RETURN
  773. /*~!*/
  774.  
  775. /*!~ "save_aweb" */
  776. save_aweb:
  777.   IF ~EXISTS(hotlist_aweb) THEN DO
  778.     'REQUESTNOTIFY "AWeb hotlist not found!" "_OK"'
  779.     RETURN
  780.   END
  781.   ELSE DO
  782.     'UPDATEPROGRESS REQ' pbsave 'CURRENT' amosaic+ibrowse+html+aweb 'PT "Saving to AWeb..."'
  783.     IF RC = 5 THEN CALL cleanup
  784.     IF(RC = 30) THEN DO
  785.       'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  786.       CALL cleanup
  787.     END
  788.     CALL OPEN(htlst,hotlist_aweb,'a')
  789.     DO sw = 1 TO save.count
  790.       CALL WRITELN(htlst,save.sw)
  791.       CALL WRITELN(htlst,STRIP(name.sw))
  792.     END
  793.     CALL CLOSE(htlst)
  794.   END
  795. RETURN
  796. /*~!*/
  797.  
  798. /*!~ "save_voyager" */
  799. save_voyager:
  800.   IF ~EXISTS(hotlist_voyager) THEN DO
  801.     'REQUESTNOTIFY "Voyager hotlist not found!" "_OK"'
  802.     RETURN
  803.   END
  804.   ELSE DO
  805.     'UPDATEPROGRESS REQ' pbsave 'CURRENT' amosaic+ibrowse+html+aweb+voyager 'PT "Saving to Voyager..."'
  806.     IF RC = 5 THEN CALL cleanup
  807.     IF(RC = 30) THEN DO
  808.       'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  809.       CALL cleanup
  810.     END
  811.     CALL OPEN(in,hotlist_voyager,'r')
  812.     CALL OPEN(out,'t:voyager.tmp','w')
  813.       line = READLN(in)
  814.       DO UNTIL line = '<UL>'
  815.         WRITELN(out, line)
  816.         line = READLN(in)
  817.       END
  818.       WRITELN(out, line)
  819.       DO vo = 1 TO save.count
  820.         adres = '<LI><A HREF="'||save.vo||'">'STRIP(name.vo)'</A><br>'
  821.         WRITELN(out, adres)
  822.       END
  823.       DO UNTIL EOF(in)
  824.         rest = readch(in,1048576)
  825.         WRITECH(out, rest)
  826.       END
  827.     CALL CLOSE(out)
  828.     CALL CLOSE(in)
  829.     ADDRESS COMMAND 'copy t:voyager.tmp' hotlist_voyager 'quiet'
  830.    DELETE('t:voyager.tmp')
  831.   END
  832. RETURN
  833. /*~!*/
  834.  
  835. /*!~ "save_tcpdl"*/
  836. save_tcpdl:
  837.   IF ~EXISTS(hotlist_tcpdl) THEN DO
  838.     'REQUESTNOTIFY "TCPdl hotlist not found!" "_OK"'
  839.     RETURN
  840.   END
  841.   ELSE DO
  842.     'UPDATEPROGRESS REQ' pbsave 'CURRENT' amosaic+aweb+ibrowse+voyager+html+tcpdl 'PT "Saving to TCPdl..."'
  843.     IF RC = 5 THEN CALL cleanup
  844.     IF(RC = 30) THEN DO
  845.       'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  846.       CALL cleanup
  847.     END
  848.     CALL OPEN(out,hotlist_tcpdl,'a')
  849.       DO tl = 1 TO save.count
  850.         adres = pre_tcpdl||save.tl||' 'suf_tcpdl
  851.         WRITELN(out, adres)
  852.       END
  853.     CALL CLOSE(out)
  854.   END
  855. RETURN
  856. /*~!*/
  857.  
  858. /*!~ "save_ncftp" */
  859. save_ncFTP:
  860.   IF ~EXISTS(hotlist_ncftp) THEN DO
  861.     'REQUESTNOTIFY "ncFTP hotlist not found!" "_OK"'
  862.     RETURN
  863.   END
  864.   ELSE DO
  865.     IF ftpsavemode = 'F' THEN pro_cur = ncftp
  866.     IF ftpsavemode = 'B' THEN pro_cur = pro_http + ncftp
  867.  
  868.     'UPDATEPROGRESS REQ' pbsave 'CURRENT' pro_cur 'PT "Saving to ncFTPrecent..."'
  869.     IF RC = 5 THEN CALL cleanup
  870.     IF(RC = 30) THEN DO
  871.       'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  872.       CALL cleanup
  873.     END
  874.     CALL OPEN(in,hotlist_ncftp,'r')
  875.     CALL OPEN(out,'t:ncftp.tmp','w')
  876.     CALL convdate
  877.       DO nc = 1 TO save.count
  878.         CALL prepftp(save.nc)
  879.         adres = LEFT(ftpadr,34,' ') now ftpdir
  880.         WRITELN(out, adres)
  881.       END
  882.       DO UNTIL EOF(in)
  883.         rest = readch(in,1048576)
  884.         WRITECH(out, rest)
  885.       END
  886.     CALL CLOSE(out)
  887.     CALL CLOSE(in)
  888.     ADDRESS COMMAND 'copy t:ncftp.tmp' hotlist_ncftp 'quiet'
  889.    DELETE('t:ncftp.tmp')
  890.   END
  891. RETURN
  892. /*~!*/
  893.  
  894. /*!~ "save_dopus" */
  895. save_dopus:
  896.   IF ~EXISTS(hotlist_dopus) THEN DO
  897.     'REQUESTNOTIFY "DOpusFTP hotlist not found!" "_OK"'
  898.     RETURN
  899.   END
  900.   ELSE DO
  901.     IF ftpsavemode = 'F' THEN pro_cur = ncftp+dopus
  902.     IF ftpsavemode = 'B' THEN pro_cur = pro_http + ncftp + dopus
  903.  
  904.     'UPDATEPROGRESS REQ' pbsave 'CURRENT' pro_cur 'PT "Saving to DOpusFTP..."'
  905.     IF RC = 5 THEN CALL cleanup
  906.     IF(RC = 30) THEN DO
  907.       'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  908.       CALL cleanup
  909.     END
  910.     CALL OPEN(in,hotlist_dopus,'a')
  911.       DO dp = 1 TO save.count
  912.         CALL prepftp(save.dp)
  913.         IF ftpsitename THEN name.dp = ftpadr
  914.         IF ftpfile = '' THEN ftpname = name.dp
  915.         ELSE ftpname = name.dp '('ftpfile')'
  916.         PARSE VAR ftpadr tstnum '.'
  917.         IF DATATYPE(tstnum, 'NUM') THEN adres = 'anon alias="'ftpname'" addr="'ftpadr'" dir="'ftpdir'"'
  918.         ELSE adres = 'anon alias="'ftpname'" host="'ftpadr'" dir="'ftpdir'"'
  919.         WRITELN(in, adres)
  920.       END
  921.     CALL CLOSE(in)
  922.   END
  923. RETURN
  924. /*~!*/
  925.  
  926. /*!~ "save_guiftp" */
  927. save_guiftp:
  928.   IF ~EXISTS(hotlist_guiftp) THEN DO
  929.     'REQUESTNOTIFY "GUI-FTP hotlist not found!" "_OK"'
  930.     RETURN
  931.   END
  932.   ELSE DO
  933.     IF ftpsavemode = 'F' THEN pro_cur = ncftp+dopus+guiftp
  934.     IF ftpsavemode = 'B' THEN pro_cur = pro_http + ncftp + dopus + guiftp
  935.  
  936.     'UPDATEPROGRESS REQ' pbsave 'CURRENT' pro_cur 'PT "Saving to GUI-FTP..."'
  937.     IF RC = 5 THEN CALL cleanup
  938.     IF(RC = 30) THEN DO
  939.       'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  940.       CALL cleanup
  941.     END
  942.     CALL OPEN(in, hotlist_guiftp, 'A')
  943.       DO gf = 1 TO save.count
  944.         CALL prepftp(save.gf)
  945.         IF ftpsitename THEN name.gf = ftpadr
  946.         IF ftpfile ~= '' THEN ftpname = name.gf '('ftpfile')'
  947.         ELSE ftpname = name.gf
  948.         WRITELN(in, 'machine' ftpadr)
  949.         WRITELN(in, ' description' ftpname)
  950.         WRITELN(in, ' dir' ftpdir)
  951.         WRITELN(in, ' anonftp')
  952.         WRITELN(in, '')
  953.       END
  954.     CALL CLOSE(in)
  955.   END
  956. RETURN
  957. /*~!*/
  958.  
  959. /*!~ "save_amftp" */
  960. save_amftp:
  961.   IF ~SHOW('p', 'AMFTP.1') THEN DO
  962.     'REQUESTNOTIFY TEXT "AmFTP is not running.\n\nTo save the addresses to the AmFTP\nhotlist AmFTP needs to be running.\n\nStart AmFTP?" BT "_Yes|_No"'
  963.     IF RC = 0 THEN DO
  964.       IF RESULT = 1 THEN DO
  965.         IF ~EXISTS(path_amftp) THEN DO
  966.           'REQUESTNOTIFY TEXT "AmFTP not found." BT "_OK"'
  967.           RETURN
  968.         END
  969.         ELSE DO
  970.           IF ~SHOWLIST('L','bsdsocket.library') THEN DO
  971.              ADDRESS COMMAND tcp_ip
  972.              IF SHOWLIST('L','bsdsocket.library') THEN CALL run_amftp
  973.              ELSE DO
  974.                'REQUESTNOTIFY TEXT "No bsdsocket.library found.\n\nCan''t save to AmFTP hotlist" BT "_OK"'
  975.              END
  976.           END
  977.           ELSE DO
  978.             CALL run_amftp
  979.           END
  980.         END
  981.       END
  982.       IF RESULT = 0 THEN RETURN
  983.     END
  984.   END
  985.  
  986.   IF SHOW('p', 'AMFTP.1') THEN DO
  987.     IF ftpsavemode = 'F' THEN pro_cur = ncftp+dopus+guiftp+amftp
  988.     IF ftpsavemode = 'B' THEN pro_cur = pro_http+ncftp+dopus+guiftp+amftp
  989.  
  990.     ADDRESS(thorport)
  991.     'THORTOFRONT'
  992.     'UPDATEPROGRESS REQ' pbsave 'CURRENT' pro_cur 'PT "Saving to AmFTP..."'
  993.     IF RC = 5 THEN CALL cleanup
  994.     IF(RC = 30) THEN DO
  995.       'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  996.       CALL cleanup
  997.     END
  998.     ADDRESS AMFTP.1
  999.     DO af = 1 TO save.count
  1000.       CALL prepftp(save.af)
  1001.       IF ftpsitename THEN name.af = ftpadr
  1002.       IF ftpfile ~= '' THEN ftpname = name.af '('ftpfile')'
  1003.       ELSE ftpname = name.af
  1004.       STEM.HOST     = ftpadr
  1005.       STEM.PORT     = 21
  1006.       STEM.ADT      = 0
  1007.       STEM.ANON     = 1
  1008.       STEM.DEFDIR   = ftpdir
  1009.       'CREATEPROFILE "'ftpname'"'
  1010.       'SETPROFILE' RESULT STEM
  1011.     END
  1012.     'SAVEPROFILES'
  1013.     ADDRESS(thorport)
  1014.   END
  1015.   ELSE DO
  1016.     'REQUESTNOTIFY TEXT "AmFTP is not running.\n\nCould not save to AmFTP." BT "_OK"'
  1017.   END
  1018. RETURN
  1019. /*~!*/
  1020.  
  1021. /*!~ "run_amftp" */
  1022. run_amftp:
  1023.   ADDRESS COMMAND
  1024.     'run <>nil:' path_amftp
  1025.     'WaitForPort AMFTP.1'
  1026. RETURN
  1027. /*~!*/
  1028.  
  1029. /*!~ "prepftp" */
  1030. prepftp:
  1031.   tmpftp = ARG(1)
  1032.   ftpfile = ''
  1033.   tmpftp = TRANSLATE(tmpftp, '/', ':')
  1034.   PARSE VAR tmpftp 'ftp///' ftpadr '/' ftpdir
  1035.   CALL filter(ftpadr,2)
  1036.   ftpadr = RESULT
  1037.   IF ftpdir = '' THEN ftpdir = '/'
  1038.   IF (ftpdir ~= '' & (dopus = 1 | guiftp = 1 | amftp = 1)) THEN DO
  1039.     IF LASTPOS('/', ftpdir) < LENGTH(ftpdir) THEN DO
  1040.       DO ft = 1 TO filetype.count
  1041.         IF POS(filetype.ft, UPPER(ftpdir)) ~= 0 THEN DO
  1042.           ftpfile = SUBSTR(ftpdir, (LASTPOS('/', ftpdir) + 1))
  1043.           ftpdir = SUBSTR(ftpdir, 1, LASTPOS('/', ftpdir))
  1044.         END
  1045.       END
  1046.     END
  1047.   END
  1048. RETURN
  1049. /*~!*/
  1050.  
  1051. /*!~ "convdate" */
  1052. convdate:
  1053.   DROP dat.
  1054.   datum = Date('S')
  1055.   tijd  = time('N')
  1056.   dat.HOUR  = SUBSTR(tijd,1,2)
  1057.   dat.MIN   = SUBSTR(tijd,4,2)
  1058.   dat.SEC   = SUBSTR(tijd,7,2)
  1059.   dat.YEAR  = SUBSTR(datum,1,4)
  1060.   dat.MONTH = SUBSTR(datum,5,2)
  1061.   dat.MDAY  = SUBSTR(datum,7,2)
  1062.   ADDRESS BBSREAD DATE2AMIGA dat
  1063.   now = RESULT
  1064. RETURN
  1065. /*~!*/
  1066. /*~!*/
  1067.  
  1068. /*!~ "Misc functions" */
  1069. /*!~ "LoadPrefs" */
  1070. loadprefs:
  1071.   IF ~EXISTS(cfgpath||cfgfile) THEN DO
  1072.     Address(thorport)
  1073.     'Requestnotify TEXT "Could not find the configuration file.\nRun CfgGetNET to create one." BT "_OK"'
  1074.     EXIT
  1075.   END
  1076.   ELSE DO
  1077.     CALL OPEN(prf,cfgpath||cfgfile,'R')
  1078.       DO UNTIL EOF(prf)
  1079.         line = READLN(prf)
  1080.         SELECT
  1081.           WHEN UPPER(WORD(line,1)) = 'BBS' THEN DO
  1082.             bbs = SUBWORD(line,2)
  1083.           END
  1084.           WHEN UPPER(WORD(line,1)) = 'ASKFR' THEN DO
  1085.             askfr = WORD(line,2)
  1086.           END
  1087.           WHEN Upper(Word(line,1)) = 'REQDIR' THEN DO
  1088.             reqdir = SubWord(line,2)
  1089.           END
  1090.           WHEN Upper(Word(line,1)) = 'FTPSAVEMODE' THEN DO
  1091.             ftpsavemode = UPPER(WORD(line,2))
  1092.           END
  1093.           WHEN Upper(Word(line,1)) = 'FTPSITENAME' THEN DO
  1094.             ftpsitename = UPPER(WORD(line,2))
  1095.           END
  1096.           WHEN UPPER(WORD(line,1)) = 'AMOSAIC' THEN DO
  1097.             hotlist_amosaic = WORD(line,2)
  1098.             amosaic = WORD(line,3)
  1099.           END
  1100.           WHEN UPPER(WORD(line,1)) = 'AWEB' THEN DO
  1101.             hotlist_aweb = WORD(line,2)
  1102.             aweb = WORD(line,3)
  1103.           END
  1104.           WHEN UPPER(WORD(line,1)) = 'IBROWSE' THEN DO
  1105.             hotlist_ibrowse = WORD(line,2)
  1106.             ibrowse = WORD(line,3)
  1107.           END
  1108.           WHEN UPPER(WORD(line,1)) = 'VOYAGER' THEN DO
  1109.             hotlist_voyager = WORD(line,2)
  1110.             voyager = WORD(line,3)
  1111.           END
  1112.           WHEN UPPER(WORD(line,1)) = 'HTML' THEN DO
  1113.             hotlist_html = WORD(line,2)
  1114.             html = WORD(line,3)
  1115.           END
  1116.           WHEN UPPER(WORD(line,1)) = 'NCFTP' THEN DO
  1117.             hotlist_ncftp = WORD(line,2)
  1118.             ncftp = WORD(line,3)
  1119.           END
  1120.           WHEN UPPER(WORD(line,1)) = 'DOPUS' THEN DO
  1121.             hotlist_dopus = WORD(line,2)
  1122.             dopus = WORD(line,3)
  1123.           END
  1124.           WHEN UPPER(WORD(line,1)) = 'GUIFTP' THEN DO
  1125.             hotlist_guiftp = WORD(line,2)
  1126.             guiftp = WORD(line,3)
  1127.           END
  1128.           WHEN UPPER(WORD(line,1)) = 'AMFTP' THEN DO
  1129.             path_amftp = WORD(line,2)
  1130.             amftp = WORD(line,3)
  1131.           END
  1132.           WHEN UPPER(WORD(line,1)) = 'TCPDL' THEN DO
  1133.             hotlist_tcpdl = WORD(line,2)
  1134.             tcpdl = WORD(line,3)
  1135.           END
  1136.           WHEN UPPER(WORD(line,1)) = 'TCPDL_PRE' THEN DO
  1137.             pre_tcpdl = SUBWORD(line,2)
  1138.           END
  1139.           WHEN UPPER(WORD(line,1)) = 'TCPDL_SUF' THEN DO
  1140.             suf_tcpdl = SUBWORD(line,2)
  1141.           END
  1142.           WHEN UPPER(WORD(line,1)) = 'TCP-IP' THEN DO
  1143.             tcp_ip = SUBWORD(line,2)
  1144.           END
  1145.           OTHERWISE NOP
  1146.         END
  1147.       END
  1148.     CALL CLOSE(prf)
  1149.     CALL checkprefs
  1150.   END
  1151. RETURN
  1152. /*~!*/
  1153.  
  1154. /*!~ "CheckPrefs" */
  1155. checkprefs:
  1156.   IF ~DATATYPE(askfr, 'BIN')       THEN CALL prefserror('ASKFR')
  1157.   IF ~DATATYPE(ftpsavemode, 'ALP') THEN CALL prefserror('FTPSAVEMODE')
  1158.   IF ~DATATYPE(ftpsitename, 'BIN') THEN CALL prefserror('FTPSITENAME')
  1159.   IF ~DATATYPE(amosaic, 'BIN')     THEN CALL prefserror('AMOSAIC')
  1160.   IF ~DATATYPE(aweb, 'BIN')        THEN CALL prefserror('AWEB')
  1161.   IF ~DATATYPE(ibrowse, 'BIN')     THEN CALL prefserror('IBROWSE')
  1162.   IF ~DATATYPE(voyager, 'BIN')     THEN CALL prefserror('VOYAGER')
  1163.   IF ~DATATYPE(html, 'BIN')        THEN CALL prefserror('HTML')
  1164.   IF ~DATATYPE(ncftp, 'BIN')       THEN CALL prefserror('NCFTP')
  1165.   IF ~DATATYPE(dopus, 'BIN')       THEN CALL prefserror('DOPUS')
  1166.   IF ~DATATYPE(guiftp, 'BIN')      THEN CALL prefserror('GUIFTP')
  1167.   IF ~DATATYPE(amftp, 'BIN')       THEN CALL prefserror('AMFTP')
  1168.   IF ~DATATYPE(tcpdl, 'BIN')       THEN CALL prefserror('TCPDL')
  1169. RETURN
  1170. /*~!*/
  1171.  
  1172. /*!~ "PrefsError" */
  1173. prefserror:
  1174.   prferr = ARG(1)
  1175.   ADDRESS(thorport)
  1176.   'REQUESTNOTIFY TEXT "The config file is not in the\ncorrect format. An error occured at\nor before 'prferr'.\nPlease run CfgGetNET to correct this.\n\nIf the problem remains, contact\nthe author at rvhooff@caiw.nl" BT "_OK"'
  1177.   CALL cleanup
  1178. RETURN
  1179. /*~!*/
  1180.  
  1181. /*!~ "Filter" */
  1182. filter:
  1183.   PARSE ARG adres,fltr
  1184.   lngth = LENGTH(adres)
  1185.   IF fltr = 2 THEN adres=REVERSE(adres)
  1186.   DO i = 1 TO filter.fltr.count
  1187.     check = POS(filter.fltr.i, adres)
  1188.     IF check ~=0 THEN adres = DELSTR(adres, check)
  1189.   END
  1190.   punt = LASTPOS('.', adres)
  1191.   IF punt ~=0 THEN lngth = length(adres)
  1192.   IF (punt = lngth) THEN adres = DELSTR(adres, punt)
  1193.   IF fltr = 2 THEN adres=REVERSE(adres)
  1194. RETURN(adres)
  1195. /*~!*/
  1196.  
  1197. /*!~ "ListFound" */
  1198. listfound:
  1199.   IF found.COUNT > 0 THEN DO
  1200.     IF scanaminet = 1 THEN foundtitel = 'Select files to download.'
  1201.     ELSE foundtitel = 'Select address(es) to save.'
  1202.     'REQUESTLIST INSTEM' found 'OUTSTEM' save 'TITLE "'foundtitel' Total: 'num'" MULTISELECT SIZEGADGET'
  1203.     IF (RC = 30) THEN DO
  1204.       'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  1205.       CALL cleanup
  1206.     END
  1207.     IF RC ~= 5 THEN ok = 1
  1208.   END
  1209.   IF found.COUNT = 0 THEN DO
  1210.     IF scanhttp = 1 THEN titel = 'HTTP addresses'
  1211.     IF scanemail = 1 THEN titel = 'Email addresses'
  1212.     IF scanftp = 1 THEN titel = 'FTP addresses'
  1213.     IF scanaminet = 1 THEN titel = 'Aminet files'
  1214.     'REQUESTNOTIFY TEXT "No' titel 'found in this message." BT "_Ok"'
  1215.   END
  1216. RETURN
  1217. /*~!*/
  1218.  
  1219. /*!~ "ListSave" */
  1220. listsave:
  1221.   PARSE ARG soort
  1222.     DO svc = 1 TO save.count
  1223.       IF name.svc = 'NAME.'svc THEN name.svc = subj '('svc')'
  1224.       showname.svc = LEFT(name.svc,20,' ')
  1225.       show.svc = showname.svc' - 'save.svc
  1226.     END
  1227.     sep = save.count +1
  1228.     but = save.count +2
  1229.     show.sep = ''
  1230.     show.but = 'SAVE'
  1231.     show.count = save.count+2
  1232.   IF soort = 1 THEN titel = 'Select to enter a name'
  1233.   IF soort = 2 THEN titel = 'Select address to edit userdata'
  1234.   'REQUESTLIST INSTEM' show 'TITLE "'titel'" SIZEGADGET'
  1235.   IF (RC = 30) THEN DO
  1236.     'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  1237.     CALL cleanup
  1238.   END
  1239.   IF RC ~= 5 THEN DO
  1240.     selected = RESULT
  1241.     IF selected = 'SAVE' THEN DO 
  1242.       IF soort = 1 THEN DO
  1243.         CALL savehotlist
  1244.         RETURN
  1245.       END
  1246.       IF soort = 2 THEN DO
  1247.         CALL save_userdata
  1248.         RETURN
  1249.       END
  1250.     END
  1251.     DO n = 1 TO save.count
  1252.       IF selected = show.n THEN DO
  1253.         IF soort = 1 THEN DO
  1254.           'REQUESTNOTIFY TEXT "What do you want to change?" BT "_Name|_URL"'
  1255.           IF RESULT = 1 THEN DO
  1256.             'REQUESTSTRING title "Enter a name" BT "_OK|_Cancel" BODY "'save.n'" ID "'name.n'"'
  1257.             IF RC = 0 THEN name.n = RESULT
  1258.             IF RC = 5 THEN name.n = name.n
  1259.           END
  1260.           IF RESULT = 0 THEN DO
  1261.             'REQUESTSTRING title "Edit the URL" BT "_OK|_Cancel" BODY "'save.n'" ID "'save.n'"'
  1262.             IF RC = 0 THEN save.n = RESULT
  1263.             IF RC = 5 THEN save.n = save.n
  1264.           END
  1265.         END
  1266.         IF soort = 2 THEN SIGNAL userdata
  1267.       END
  1268.     END
  1269.     IF soort = 1 THEN SIGNAL listsave(1)
  1270.     IF soort = 2 THEN SIGNAL listsave(2)
  1271.   END
  1272. RETURN
  1273. /*~!*/
  1274.  
  1275. /*!~ "Create_DLEvent" */
  1276. create_dlevent:
  1277. ADDRESS BBSREAD
  1278.   DO event = 1 to save.count
  1279.     PARSE VAR save.event save.event '(' dir.event ')'
  1280.     EVENTSTEM.FILENAME = STRIP(save.event)
  1281.     EVENTSTEM.DIRECTORY = dir.event
  1282.     'WRITEBREVENT BBSNAME "'bbs'" EVENT' EVE_DOWNLOAD 'STEM' EVENTSTEM
  1283.     IF (RC ~= 0) THEN DO
  1284.       ADDRESS(thorport)
  1285.       'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  1286.       CALL cleanup
  1287.     END
  1288.   END
  1289. RETURN
  1290. /*~!*/
  1291.  
  1292. /*!~ "Request_File" */
  1293. request_file:
  1294.   DROP selfile.
  1295.   'REQUESTFILE TITLE "Select file to scan." ID "'reqdir'" FP MS OUTSTEM' selfile
  1296.   IF (RC = 30) THEN DO
  1297.     'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  1298.     CALL cleanup
  1299.   END
  1300.   IF RC = 5 THEN CALL cleanup
  1301.   IF RC = 0 THEN DO
  1302.     'OPENPROGRESS TITLE "'maintitle'" TOTAL' selfile.count 'AT "_Abort" PT "Scanning messages (0/'selfile.count')"'
  1303.     IF(RC ~= 0) THEN DO
  1304.       'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  1305.       CALL cleanup
  1306.     END
  1307.     ELSE progressid1 = RESULT
  1308.  
  1309.     DO fl = 1 TO selfile.COUNT
  1310.       'UPDATEPROGRESS REQ' progressid1 'CURRENT' fl 'PT "Scanning messages ('fl'/'selfile.count')"'
  1311.       IF RC = 5 THEN CALL cleanup
  1312.       IF(RC = 30) THEN DO
  1313.         'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  1314.         CALL cleanup
  1315.       END
  1316.       tempfile = selfile.fl
  1317.       IF OPEN(reqtmp, tempfile, 'R') THEN DO
  1318.         CALL CLOSE(reqtmp)
  1319.         reqfile = 1
  1320.         subj = tempfile
  1321.         fromname = tempfile
  1322.         CALL main
  1323.       END
  1324.     END
  1325.   END
  1326. RETURN
  1327. /*~!*/
  1328.  
  1329. /*!~ "AskREQ" */
  1330. askreq:
  1331.   'REQUESTNOTIFY TEXT "Do you want to scan messages or select a file on disk?" BT "_Messages|_File|_Quit"'
  1332.   SELECT
  1333.     WHEN RESULT = 1 THEN req = ''
  1334.     WHEN RESULT = 2 THEN req = 'REQ'
  1335.     OTHERWISE CALL cleanup
  1336.   END
  1337. RETURN
  1338. /*~!*/
  1339.  
  1340. /*!~ "Dubbel" */
  1341. dubbel:
  1342.   scanadres = ARG(1)
  1343.   IF ARG(2) = 1 THEN domainOK = 1
  1344.   dubbel = POS(UPPER(scanadres'|'), UPPER(sumadres))
  1345.   IF (dubbel = 0 & domainOK ~= 0) THEN DO
  1346.     num = num + 1
  1347.     'UPDATEPROGRESS REQ' progressid 'PT "Searching... ('num')"'
  1348.     found.num = scanadres
  1349.     found.count = num
  1350.     sumadres = sumadres||scanadres'|'
  1351.   END
  1352. RETURN
  1353. /*~!*/
  1354.  
  1355. /*!~ "CheckDomain" */
  1356. checkdomain:
  1357.   adrespart = ARG(1)
  1358.   adrespart = TRANSLATE(adrespart, '/', ':')
  1359.   iptype = ARG(2)
  1360.   PARSE VAR adrespart '.' domainchk '/'
  1361.   IF iptype = 'IP' THEN domainchk = filter(domainchk,2)
  1362.   IF domainchk ~= '' THEN DO
  1363.     dom = LASTPOS('.', domainchk)
  1364.     INTERPRET "PARSE VAR domainchk . "dom" domainchk2"
  1365.     IF (Length(domainchk2) >= 2 & Length(domainchk2) <= 4) THEN domainOK = Pos(Upper(domainchk2)||'.', domains)
  1366.     ELSE domainOK = 0
  1367.   END
  1368.   ELSE domainOK = 0
  1369. RETURN
  1370. /*~!*/
  1371.  
  1372. /*!~ "Syntax/Halt/Cleanup" */
  1373. SYNTAX:
  1374. SAY 'SYNTAX ERROR'
  1375. SAY 'Error 'rc' in line 'sigl': 'errortext(rc)
  1376. HALT:
  1377. cleanup:
  1378.  IF opentmp = 1 THEN CLOSE(tmp)
  1379.  IF EXISTS(tempfile) THEN IF reqfile = 0 THEN DELETE(tempfile)
  1380.  IF (progressid ~= 0) & SYMBOL('progressid') = 'VAR' THEN DO
  1381.    ADDRESS(thorport)
  1382.    'CLOSEPROGRESS REQ' progressid
  1383.  END
  1384.  IF (progressid1 ~= 0) & SYMBOL('progressid1') = 'VAR' THEN DO
  1385.    ADDRESS(thorport)
  1386.    'CLOSEPROGRESS REQ' progressid1
  1387.  END
  1388.  IF (pbsave ~= 0) & SYMBOL('pbsave') = 'VAR' THEN DO
  1389.    ADDRESS(thorport)
  1390.    'CLOSEPROGRESS REQ' pbsave
  1391.  END
  1392. EXIT
  1393. /*~!*/
  1394. /*~!*/
  1395.  
  1396.